home *** CD-ROM | disk | FTP | other *** search
Text File | 1991-11-14 | 57.1 KB | 1,698 lines |
- Newsgroups: comp.sources.misc
- From: karl@sugar.neosoft.com (Karl Lehenbauer)
- Subject: v25i069: tcl - tool command language, version 6.1, Part01/33
- Message-ID: <csm-v25i069=tcl.142226@sparky.IMD.Sterling.COM>
- X-Md4-Signature: 01e9b1ecbe8cf851598974aa6c84014f
- Date: Thu, 14 Nov 1991 20:25:03 GMT
- Approved: kent@sparky.imd.sterling.com
-
- Submitted-by: karl@sugar.neosoft.com (Karl Lehenbauer)
- Posting-number: Volume 25, Issue 69
- Archive-name: tcl/part01
- Environment: UNIX
-
- This is a posting of the source and documentation for Tcl, an
- embeddable tool command language, created by John Ousterhout.
-
- This was posted at John's request by Karl Lehenbauer (karl@NeoSoft.com).
-
- This is release 6.1.
-
- For more information, see the file "tcl6.1/README" in this release.
-
- The file tclVar.c had to be split into two files, tclVar.c.1 and tclVar.c.2,
- in order to not exceed the maximum size of a Usenet posting. Similarly,
- the file doc/Tcl.man was split into three files, doc/Tcl.man.1, doc/Tcl.man.2
- and doc/Tcl.man.3. Although these files should be automatically concatenated
- when you unpack the last part, if they are not for some reason, you should put
- them together by hand.
-
- Good luck. If you have any problems with the Usenet distribution, contact
- Karl or Mark Diekhans (markd@Grizzly.com). For problems with Tcl 6.1 itself,
- contact John Ousterhout (ouster@sprite.berkeley.edu).
-
- Regards,
- Karl Lehenbauer (karl@NeoSoft.com)
- -----------
- #! /bin/sh
- # This is a shell archive. Remove anything before this line, then unpack
- # it by saving it into a file and typing "sh file". To overwrite existing
- # files, type "sh file -c". You can also feed this as standard input via
- # unshar, or by typing "sh <file", e.g.. If this archive is complete, you
- # will see the following message at the end:
- # "End of archive 1 (of 33)."
- # Contents: README tcl6.1 tcl6.1/MANIFEST tcl6.1/Makefile
- # tcl6.1/compat tcl6.1/compat/README tcl6.1/compat/dirent.h
- # tcl6.1/compat/dirent2.h tcl6.1/compat/limits.h
- # tcl6.1/compat/opendir.c tcl6.1/compat/stdlib.h
- # tcl6.1/compat/string.h tcl6.1/compat/strstr.c
- # tcl6.1/compat/testpid.c tcl6.1/compat/testwait.c tcl6.1/doc
- # tcl6.1/library tcl6.1/library/mkindex.tcl
- # tcl6.1/library/parray.tcl tcl6.1/library/tclIndex tcl6.1/panic.c
- # tcl6.1/regexp.h tcl6.1/tests tcl6.1/tests/all
- # tcl6.1/tests/concat.test tcl6.1/tests/defs tcl6.1/tests/eval.test
- # tcl6.1/tests/join.test tcl6.1/tests/llength.test
- # tcl6.1/tests/lsearch.test tcl6.1/tests/lsort.test
- # tcl6.1/tests/split.test tcl6.1/tests/unknown.test
- # Wrapped by karl@one on Tue Nov 12 19:44:10 1991
- PATH=/bin:/usr/bin:/usr/ucb ; export PATH
- if test -f 'README' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'README'\"
- else
- echo shar: Extracting \"'README'\" \(955 characters\)
- sed "s/^X//" >'README' <<'END_OF_FILE'
- X
- XThis is a posting of the source and documentation for Tcl, an
- Xembeddable tool command language, created by John Ousterhout.
- X
- XThis is release 6.1.
- X
- XFor more information, see the file "tcl6.1/README" in this release.
- X
- XThis was posted at John's request by Karl Lehenbauer (karl@NeoSoft.com).
- X
- XThe file tclVar.c had to be split into two files, tclVar.c.1 and tclVar.c.2,
- Xin order to not exceed the maximum size of a Usenet posting. Similarly,
- Xthe file doc/Tcl.man was split into three files, doc/Tcl.man.1, doc/Tcl.man.2
- Xand doc/Tcl.man.3. Although these files should be automatically concatenated
- Xwhen you unpack the last part, if they are not for some reason, you should put
- Xthem together by hand.
- X
- XGood luck. If you have any problems with the Usenet distribution, contact
- XKarl or Mark Diekhans (markd@Grizzly.com). For problems with Tcl 6.1 itself,
- Xcontact John Ousterhout (ouster@sprite.berkeley.edu).
- X
- XRegards,
- XKarl Lehenbauer (karl@NeoSoft.com)
- X
- END_OF_FILE
- if test 955 -ne `wc -c <'README'`; then
- echo shar: \"'README'\" unpacked with wrong size!
- fi
- # end of 'README'
- fi
- if test ! -d 'tcl6.1' ; then
- echo shar: Creating directory \"'tcl6.1'\"
- mkdir 'tcl6.1'
- fi
- if test -f 'tcl6.1/MANIFEST' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/MANIFEST'\"
- else
- echo shar: Extracting \"'tcl6.1/MANIFEST'\" \(4022 characters\)
- sed "s/^X//" >'tcl6.1/MANIFEST' <<'END_OF_FILE'
- X File Name Archive # Description
- X-----------------------------------------------------------
- X README 1
- X tcl6.1 1
- X tcl6.1/MANIFEST 1 This shipping list
- X tcl6.1/Makefile 1
- X tcl6.1/README 8
- X tcl6.1/changes 11
- X tcl6.1/compat 1
- X tcl6.1/compat/README 1
- X tcl6.1/compat/dirent.h 1
- X tcl6.1/compat/dirent2.h 1
- X tcl6.1/compat/limits.h 1
- X tcl6.1/compat/opendir.c 1
- X tcl6.1/compat/stdlib.h 1
- X tcl6.1/compat/strerror.c 10
- X tcl6.1/compat/string.h 1
- X tcl6.1/compat/strstr.c 1
- X tcl6.1/compat/strtol.c 2
- X tcl6.1/compat/strtoul.c 3
- X tcl6.1/compat/testpid.c 1
- X tcl6.1/compat/testwait.c 1
- X tcl6.1/config 7
- X tcl6.1/doc 1
- X tcl6.1/doc/AddErrInfo.man 6
- X tcl6.1/doc/AssembCmd.man 5
- X tcl6.1/doc/Backslash.man 4
- X tcl6.1/doc/Concat.man 4
- X tcl6.1/doc/CrtCommand.man 6
- X tcl6.1/doc/CrtInterp.man 4
- X tcl6.1/doc/CrtPipelin.man 5
- X tcl6.1/doc/CrtTrace.man 6
- X tcl6.1/doc/Eval.man 5
- X tcl6.1/doc/ExprLong.man 5
- X tcl6.1/doc/Fork.man 6
- X tcl6.1/doc/GetInt.man 5
- X tcl6.1/doc/Hash.man 10
- X tcl6.1/doc/History.man 4
- X tcl6.1/doc/Interp.man 7
- X tcl6.1/doc/SetResult.man 8
- X tcl6.1/doc/SetVar.man 8
- X tcl6.1/doc/SplitList.man 6
- X tcl6.1/doc/StrMatch.man 3
- X tcl6.1/doc/Tcl.man.1 27
- X tcl6.1/doc/Tcl.man.2 33
- X tcl6.1/doc/Tcl.man.3 32
- X tcl6.1/doc/TildeSubst.man 4
- X tcl6.1/doc/TraceVar.man 14
- X tcl6.1/doc/library.man 9
- X tcl6.1/doc/usenix.text 31
- X tcl6.1/library 1
- X tcl6.1/library/init.tcl 3
- X tcl6.1/library/mkindex.tcl 1
- X tcl6.1/library/parray.tcl 1
- X tcl6.1/library/tclIndex 1
- X tcl6.1/panic.c 1
- X tcl6.1/regexp.c 18
- X tcl6.1/regexp.h 1
- X tcl6.1/tcl.h 9
- X tcl6.1/tclAssem.c 4
- X tcl6.1/tclBasic.c 17
- X tcl6.1/tclCkalloc.c 12
- X tcl6.1/tclCmdAH.c 16
- X tcl6.1/tclCmdIL.c 20
- X tcl6.1/tclCmdMZ.c 28
- X tcl6.1/tclEnv.c 9
- X tcl6.1/tclExpr.c 26
- X tcl6.1/tclGet.c 3
- X tcl6.1/tclGlob.c 11
- X tcl6.1/tclHash.c 16
- X tcl6.1/tclHash.h 3
- X tcl6.1/tclHistory.c 21
- X tcl6.1/tclInt.h 23
- X tcl6.1/tclParse.c 24
- X tcl6.1/tclProc.c 12
- X tcl6.1/tclTest.c 2
- X tcl6.1/tclUnix.h 5
- X tcl6.1/tclUnixAZ.c 30
- X tcl6.1/tclUnixStr.c 12
- X tcl6.1/tclUnixUtil.c 19
- X tcl6.1/tclUtil.c 29
- X tcl6.1/tclVar.c.1 25
- X tcl6.1/tclVar.c.2 22
- X tcl6.1/tests 1
- X tcl6.1/tests/README 3
- X tcl6.1/tests/all 1
- X tcl6.1/tests/append.test 2
- X tcl6.1/tests/case.test 2
- X tcl6.1/tests/cd.test 2
- X tcl6.1/tests/concat.test 1
- X tcl6.1/tests/defs 1
- X tcl6.1/tests/env.test 2
- X tcl6.1/tests/error.test 3
- X tcl6.1/tests/eval.test 1
- X tcl6.1/tests/exec.test 4
- X tcl6.1/tests/expr.test 14
- X tcl6.1/tests/file.test 7
- X tcl6.1/tests/for.test 3
- X tcl6.1/tests/format.test 10
- X tcl6.1/tests/glob.test 3
- X tcl6.1/tests/history.test 11
- X tcl6.1/tests/if.test 3
- X tcl6.1/tests/incr.test 2
- X tcl6.1/tests/info.test 9
- X tcl6.1/tests/join.test 1
- X tcl6.1/tests/lindex.test 2
- X tcl6.1/tests/linsert.test 2
- X tcl6.1/tests/list.test 2
- X tcl6.1/tests/llength.test 1
- X tcl6.1/tests/lrange.test 2
- X tcl6.1/tests/lreplace.test 2
- X tcl6.1/tests/lsearch.test 1
- X tcl6.1/tests/lsort.test 1
- X tcl6.1/tests/open.test 13
- X tcl6.1/tests/parse.test 10
- X tcl6.1/tests/proc.test 7
- X tcl6.1/tests/regexp.test 7
- X tcl6.1/tests/rename.test 2
- X tcl6.1/tests/scan.test 15
- X tcl6.1/tests/set.test 13
- X tcl6.1/tests/source.test 2
- X tcl6.1/tests/split.test 1
- X tcl6.1/tests/string.test 8
- X tcl6.1/tests/trace.test 15
- X tcl6.1/tests/unknown.test 1
- X tcl6.1/tests/uplevel.test 2
- X tcl6.1/tests/upvar.test 4
- X tcl6.1/tests/while.test 2
- END_OF_FILE
- if test 4022 -ne `wc -c <'tcl6.1/MANIFEST'`; then
- echo shar: \"'tcl6.1/MANIFEST'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/MANIFEST'
- fi
- if test -f 'tcl6.1/Makefile' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/Makefile'\"
- else
- echo shar: Extracting \"'tcl6.1/Makefile'\" \(1820 characters\)
- sed "s/^X//" >'tcl6.1/Makefile' <<'END_OF_FILE'
- X#
- X# This Makefile is for use when distributing Tcl to the outside world.
- X# It is normally set up by running the "config" script. Before modifying
- X# this file by hand, you should read through the "config" script to see
- X# what it does.
- X#
- X# Some changes you may wish to make here:
- X#
- X# 1. To compile for non-UNIX systems (so that only the non-UNIX-specific
- X# commands are available), change the OBJS line below so it doesn't
- X# include ${UNIX_OBJS}. Also, add the switch "-DTCL_GENERIC_ONLY" to
- X# CFLAGS. Lastly, you'll have to provide your own replacement for the
- X# "panic" procedure (see panic.c for what the current one does).
- X#
- X# 2. ANSI-C procedure prototypes are turned on by default if supported
- X# by the compiler. To turn them off, add "-DNO_PROTOTYPE" to CFLAGS
- X# below.
- X#
- X# 3. If you've put the Tcl script library in a non-standard place, change
- X# the definition of TCL_LIBRARY to correspond to its location on your
- X# system.
- X#
- X
- XTCL_LIBRARY = /usr/local/lib/tcl
- X
- XCC = cc
- XCFLAGS = -g -I. -DTCL_LIBRARY=\"${TCL_LIBRARY}\"
- X
- XGENERIC_OBJS = regexp.o tclAssem.o tclBasic.o tclCkalloc.o \
- X tclCmdAH.o tclCmdIL.o tclCmdMZ.o tclExpr.o tclGet.o \
- X tclHash.o tclHistory.o tclParse.o tclProc.o tclUtil.o \
- X tclVar.o
- X
- XUNIX_OBJS = panic.o tclEnv.o tclGlob.o tclUnixAZ.o tclUnixStr.o \
- X tclUnixUtil.o
- X
- XCOMPAT_OBJS = strerror.o opendir.o strstr.o strtoul.o
- X
- XOBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS}
- X
- Xlibtcl.a: ${OBJS}
- X rm -f libtcl.a
- X ar cr libtcl.a ${OBJS}
- X
- XtclTest: tclTest.o libtcl.a
- X ${CC} ${CFLAGS} tclTest.o libtcl.a -o tclTest
- X
- Xclean:
- X rm -f ${OBJS} libtcl.a tclTest.o tclTest
- X
- X# The following target is used during configuration to compile
- X# a test program to see if certain facilities are available on
- X# the system.
- X
- Xtest:
- X ${CC} ${CFLAGS} test.c
- X
- X${OBJS}: tcl.h tclHash.h tclInt.h
- X${UNIX_OBJS}: tclUnix.h
- END_OF_FILE
- if test 1820 -ne `wc -c <'tcl6.1/Makefile'`; then
- echo shar: \"'tcl6.1/Makefile'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/Makefile'
- fi
- if test ! -d 'tcl6.1/compat' ; then
- echo shar: Creating directory \"'tcl6.1/compat'\"
- mkdir 'tcl6.1/compat'
- fi
- if test -f 'tcl6.1/compat/README' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/compat/README'\"
- else
- echo shar: Extracting \"'tcl6.1/compat/README'\" \(363 characters\)
- sed "s/^X//" >'tcl6.1/compat/README' <<'END_OF_FILE'
- XThis directory contains various header and code files that are
- Xused make Tcl compatible with various releases of UNIX and UNIX-like
- Xsystems. Typically, files from this directory are used to compile
- XTcl when the corresponding files aren't present in the system's
- Xlibrary area. When the whole world is POSIX-ified, this information
- Xshould become unnecessary. (?)
- END_OF_FILE
- if test 363 -ne `wc -c <'tcl6.1/compat/README'`; then
- echo shar: \"'tcl6.1/compat/README'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/compat/README'
- fi
- if test -f 'tcl6.1/compat/dirent.h' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/compat/dirent.h'\"
- else
- echo shar: Extracting \"'tcl6.1/compat/dirent.h'\" \(809 characters\)
- sed "s/^X//" >'tcl6.1/compat/dirent.h' <<'END_OF_FILE'
- X/*
- X * dirent.h --
- X *
- X * This file is a replacement for <dirent.h> in systems that
- X * support the old BSD-style <sys/dir.h> with a "struct direct".
- X *
- X * Copyright 1991 Regents of the University of California
- X * Permission to use, copy, modify, and distribute this
- X * software and its documentation for any purpose and without
- X * fee is hereby granted, provided that this copyright
- X * notice appears in all copies. The University of California
- X * makes no representations about the suitability of this
- X * software for any purpose. It is provided "as is" without
- X * express or implied warranty.
- X *
- X * $Header: /sprite/src/lib/tcl/compat/RCS/dirent.h,v 1.1 91/09/19 16:22:06 ouster Exp $ SPRITE (Berkeley)
- X */
- X
- X#ifndef _DIRENT
- X#define _DIRENT
- X
- X#include <sys/dir.h>
- X
- X#define dirent direct
- X
- X#endif /* _DIRENT */
- END_OF_FILE
- if test 809 -ne `wc -c <'tcl6.1/compat/dirent.h'`; then
- echo shar: \"'tcl6.1/compat/dirent.h'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/compat/dirent.h'
- fi
- if test -f 'tcl6.1/compat/dirent2.h' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/compat/dirent2.h'\"
- else
- echo shar: Extracting \"'tcl6.1/compat/dirent2.h'\" \(1658 characters\)
- sed "s/^X//" >'tcl6.1/compat/dirent2.h' <<'END_OF_FILE'
- X/*
- X * dirent.h --
- X *
- X * Declarations of a library of directory-reading procedures
- X * in the POSIX style ("struct dirent").
- X *
- X * Copyright 1991 Regents of the University of California
- X * Permission to use, copy, modify, and distribute this
- X * software and its documentation for any purpose and without
- X * fee is hereby granted, provided that this copyright
- X * notice appears in all copies. The University of California
- X * makes no representations about the suitability of this
- X * software for any purpose. It is provided "as is" without
- X * express or implied warranty.
- X *
- X * $Header: /sprite/src/lib/tcl/compat/RCS/dirent2.h,v 1.1 91/09/19 16:22:08 ouster Exp $ SPRITE (Berkeley)
- X */
- X
- X#ifndef _DIRENT
- X#define _DIRENT
- X
- X#ifndef _TCL
- X#include <tcl.h>
- X#endif
- X
- X/*
- X * Dirent structure, which holds information about a single
- X * directory entry.
- X */
- X
- X#define MAXNAMLEN 255
- X#define DIRBLKSIZ 512
- X
- Xstruct dirent {
- X long d_ino; /* Inode number of entry */
- X short d_reclen; /* Length of this record */
- X short d_namlen; /* Length of string in d_name */
- X char d_name[MAXNAMLEN + 1]; /* Name must be no longer than this */
- X};
- X
- X/*
- X * State that keeps track of the reading of a directory (clients
- X * should never look inside this structure; the fields should
- X * only be accessed by the library procedures).
- X */
- X
- Xtypedef struct _dirdesc {
- X int dd_fd;
- X long dd_loc;
- X long dd_size;
- X char dd_buf[DIRBLKSIZ];
- X} DIR;
- X
- X/*
- X * Procedures defined for reading directories:
- X */
- X
- Xextern void closedir _ANSI_ARGS_((DIR *dirp));
- Xextern DIR * opendir _ANSI_ARGS_((char *name));
- Xextern struct dirent * readdir _ANSI_ARGS_((DIR *dirp));
- X
- X#endif /* _DIRENT */
- END_OF_FILE
- if test 1658 -ne `wc -c <'tcl6.1/compat/dirent2.h'`; then
- echo shar: \"'tcl6.1/compat/dirent2.h'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/compat/dirent2.h'
- fi
- if test -f 'tcl6.1/compat/limits.h' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/compat/limits.h'\"
- else
- echo shar: Extracting \"'tcl6.1/compat/limits.h'\" \(893 characters\)
- sed "s/^X//" >'tcl6.1/compat/limits.h' <<'END_OF_FILE'
- X/*
- X * limits.h --
- X *
- X * This is a dummy header file to #include in Tcl when there
- X * is no limits.h in /usr/include. The file is totally empty.
- X * In case you're wondering why Tcl includes the file at all
- X * if it can be empty, it's because there's already code in
- X * tclUnix.h to #define anything that's not defined in limits.h.
- X *
- X * Copyright 1991 Regents of the University of California
- X * Permission to use, copy, modify, and distribute this
- X * software and its documentation for any purpose and without
- X * fee is hereby granted, provided that this copyright
- X * notice appears in all copies. The University of California
- X * makes no representations about the suitability of this
- X * software for any purpose. It is provided "as is" without
- X * express or implied warranty.
- X *
- X * $Header: /sprite/src/lib/tcl/compat/RCS/limits.h,v 1.1 91/09/19 16:22:08 ouster Exp $ SPRITE (Berkeley)
- X */
- END_OF_FILE
- if test 893 -ne `wc -c <'tcl6.1/compat/limits.h'`; then
- echo shar: \"'tcl6.1/compat/limits.h'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/compat/limits.h'
- fi
- if test -f 'tcl6.1/compat/opendir.c' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/compat/opendir.c'\"
- else
- echo shar: Extracting \"'tcl6.1/compat/opendir.c'\" \(1983 characters\)
- sed "s/^X//" >'tcl6.1/compat/opendir.c' <<'END_OF_FILE'
- X/*
- X * opendir.c --
- X *
- X * This file provides dirent-style directory-reading procedures
- X * for V7 Unix systems that don't have such procedures. The
- X * origin of this code is unclear, but it seems to have come
- X * originally from Larry Wall.
- X *
- X */
- X
- X#include <tclInt.h>
- X#include <tclUnix.h>
- X
- X#undef DIRSIZ
- X#define DIRSIZ(dp) \
- X ((sizeof (struct dirent) - (MAXNAMLEN+1)) + (((dp)->d_namlen+1 + 3) &~ 3))
- X
- X/*
- X * open a directory.
- X */
- XDIR *
- Xopendir(name)
- Xchar *name;
- X{
- X register DIR *dirp;
- X register int fd;
- X char *myname;
- X
- X myname = ((*name == '\0') ? "." : name);
- X if ((fd = open(myname, 0, 0)) == -1)
- X return NULL;
- X if ((dirp = (DIR *)ckalloc(sizeof(DIR))) == NULL) {
- X close (fd);
- X return NULL;
- X }
- X dirp->dd_fd = fd;
- X dirp->dd_loc = 0;
- X return dirp;
- X}
- X
- X/*
- X * read an old style directory entry and present it as a new one
- X */
- X#ifndef pyr
- X#define ODIRSIZ 14
- X
- Xstruct olddirect {
- X ino_t od_ino;
- X char od_name[ODIRSIZ];
- X};
- X#else /* a Pyramid in the ATT universe */
- X#define ODIRSIZ 248
- X
- Xstruct olddirect {
- X long od_ino;
- X short od_fill1, od_fill2;
- X char od_name[ODIRSIZ];
- X};
- X#endif
- X
- X/*
- X * get next entry in a directory.
- X */
- Xstruct dirent *
- Xreaddir(dirp)
- Xregister DIR *dirp;
- X{
- X register struct olddirect *dp;
- X static struct dirent dir;
- X
- X for (;;) {
- X if (dirp->dd_loc == 0) {
- X dirp->dd_size = read(dirp->dd_fd, dirp->dd_buf,
- X DIRBLKSIZ);
- X if (dirp->dd_size <= 0)
- X return NULL;
- X }
- X if (dirp->dd_loc >= dirp->dd_size) {
- X dirp->dd_loc = 0;
- X continue;
- X }
- X dp = (struct olddirect *)(dirp->dd_buf + dirp->dd_loc);
- X dirp->dd_loc += sizeof(struct olddirect);
- X if (dp->od_ino == 0)
- X continue;
- X dir.d_ino = dp->od_ino;
- X strncpy(dir.d_name, dp->od_name, ODIRSIZ);
- X dir.d_name[ODIRSIZ] = '\0'; /* insure null termination */
- X dir.d_namlen = strlen(dir.d_name);
- X dir.d_reclen = DIRSIZ(&dir);
- X return (&dir);
- X }
- X}
- X
- X/*
- X * close a directory.
- X */
- Xvoid
- Xclosedir(dirp)
- Xregister DIR *dirp;
- X{
- X close(dirp->dd_fd);
- X dirp->dd_fd = -1;
- X dirp->dd_loc = 0;
- X ckfree((char *) dirp);
- X}
- END_OF_FILE
- if test 1983 -ne `wc -c <'tcl6.1/compat/opendir.c'`; then
- echo shar: \"'tcl6.1/compat/opendir.c'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/compat/opendir.c'
- fi
- if test -f 'tcl6.1/compat/stdlib.h' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/compat/stdlib.h'\"
- else
- echo shar: Extracting \"'tcl6.1/compat/stdlib.h'\" \(1915 characters\)
- sed "s/^X//" >'tcl6.1/compat/stdlib.h' <<'END_OF_FILE'
- X/*
- X * stdlib.h --
- X *
- X * Declares facilities exported by the "stdlib" portion of
- X * the C library. This file isn't complete in the ANSI-C
- X * sense; it only declares things that are needed by Tcl.
- X * This file is needed even on many systems with their own
- X * stdlib.h (e.g. SunOS) because not all stdlib.h files
- X * declare all the procedures needed here (such as strtod).
- X *
- X * Copyright 1991 Regents of the University of California
- X * Permission to use, copy, modify, and distribute this
- X * software and its documentation for any purpose and without
- X * fee is hereby granted, provided that the above copyright
- X * notice appears in all copies. The University of California
- X * makes no representations about the suitability of this
- X * software for any purpose. It is provided "as is" without
- X * express or implied warranty.
- X *
- X * $Header: /user6/ouster/tcl/compat/RCS/stdlib.h,v 1.2 91/10/17 10:52:12 ouster Exp $ SPRITE (Berkeley)
- X */
- X
- X#ifndef _STDLIB
- X#define _STDLIB
- X
- X#include <tcl.h>
- X
- Xextern void abort _ANSI_ARGS_((void));
- Xextern double atof _ANSI_ARGS_((char *string));
- Xextern int atoi _ANSI_ARGS_((char *string));
- Xextern long atol _ANSI_ARGS_((char *string));
- Xextern char * calloc _ANSI_ARGS_((unsigned int numElements,
- X unsigned int size));
- Xextern int exit _ANSI_ARGS_((int status));
- Xextern int free _ANSI_ARGS_((char *blockPtr));
- Xextern char * getenv _ANSI_ARGS_((char *name));
- Xextern char * malloc _ANSI_ARGS_((unsigned int numBytes));
- Xextern void qsort _ANSI_ARGS_((char *base, int n, int size,
- X int (*compar)(char *element1, char *element2)));
- Xextern char * realloc _ANSI_ARGS_((char *ptr, unsigned int numBytes));
- Xextern double strtod _ANSI_ARGS_((char *string, char **endPtr));
- Xextern long strtol _ANSI_ARGS_((char *string, char **endPtr,
- X int base));
- Xextern unsigned long strtoul _ANSI_ARGS_((CONST char *string,
- X char **endPtr, int base));
- X
- X#endif /* _STDLIB */
- END_OF_FILE
- if test 1915 -ne `wc -c <'tcl6.1/compat/stdlib.h'`; then
- echo shar: \"'tcl6.1/compat/stdlib.h'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/compat/stdlib.h'
- fi
- if test -f 'tcl6.1/compat/string.h' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/compat/string.h'\"
- else
- echo shar: Extracting \"'tcl6.1/compat/string.h'\" \(2141 characters\)
- sed "s/^X//" >'tcl6.1/compat/string.h' <<'END_OF_FILE'
- X/*
- X * string.h --
- X *
- X * Declarations of ANSI C library procedures for string handling.
- X *
- X * Copyright 1991 Regents of the University of California
- X * Permission to use, copy, modify, and distribute this
- X * software and its documentation for any purpose and without
- X * fee is hereby granted, provided that the above copyright
- X * notice appears in all copies. The University of California
- X * makes no representations about the suitability of this
- X * software for any purpose. It is provided "as is" without
- X * express or implied warranty.
- X *
- X * $Header: /sprite/src/lib/tcl/compat/RCS/string.h,v 1.1 91/09/19 16:22:11 ouster Exp $ SPRITE (Berkeley)
- X */
- X
- X#ifndef _STRING
- X#define _STRING
- X
- X#include <tcl.h>
- X
- Xextern char * memchr _ANSI_ARGS_((char *s, int c, int n));
- Xextern int memcmp _ANSI_ARGS_((char *s1, char *s2, int n));
- Xextern char * memcpy _ANSI_ARGS_((char *t, char *f, int n));
- Xextern char * memmove _ANSI_ARGS_((char *t, char *f, int n));
- Xextern char * memset _ANSI_ARGS_((char *s, int c, int n));
- X
- Xextern int strcasecmp _ANSI_ARGS_((char *s1, char *s2));
- Xextern char * strcat _ANSI_ARGS_((char *dst, char *src));
- Xextern char * strchr _ANSI_ARGS_((char *string, int c));
- Xextern int strcmp _ANSI_ARGS_((char *s1, char *s2));
- Xextern char * strcpy _ANSI_ARGS_((char *dst, char *src));
- Xextern int strcspn _ANSI_ARGS_((char *string, char *chars));
- Xextern char * strdup _ANSI_ARGS_((char *string));
- Xextern char * strerror _ANSI_ARGS_((int error));
- Xextern int strlen _ANSI_ARGS_((char *string));
- Xextern int strncasecmp _ANSI_ARGS_((char *s1, char *s2, int n));
- Xextern char * strncat _ANSI_ARGS_((char *dst, char *src,
- X int numChars));
- Xextern int strncmp _ANSI_ARGS_((char *s1, char *s2, int nChars));
- Xextern char * strncpy _ANSI_ARGS_((char *dst, char *src,
- X int numChars));
- Xextern char * strpbrk _ANSI_ARGS_((char *string, char *chars));
- Xextern char * strrchr _ANSI_ARGS_((char *string, int c));
- Xextern int strspn _ANSI_ARGS_((char *string, char *chars));
- Xextern char * strstr _ANSI_ARGS_((char *string, char *substring));
- Xextern char * strtok _ANSI_ARGS_((char *s, char *delim));
- X
- X#endif /* _STRING */
- END_OF_FILE
- if test 2141 -ne `wc -c <'tcl6.1/compat/string.h'`; then
- echo shar: \"'tcl6.1/compat/string.h'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/compat/string.h'
- fi
- if test -f 'tcl6.1/compat/strstr.c' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/compat/strstr.c'\"
- else
- echo shar: Extracting \"'tcl6.1/compat/strstr.c'\" \(1922 characters\)
- sed "s/^X//" >'tcl6.1/compat/strstr.c' <<'END_OF_FILE'
- X/*
- X * strstr.c --
- X *
- X * Source code for the "strstr" library routine.
- X *
- X * Copyright 1988-1991 Regents of the University of California
- X * Permission to use, copy, modify, and distribute this
- X * software and its documentation for any purpose and without
- X * fee is hereby granted, provided that the above copyright
- X * notice appears in all copies. The University of California
- X * makes no representations about the suitability of this
- X * software for any purpose. It is provided "as is" without
- X * express or implied warranty.
- X */
- X
- X#ifndef lint
- Xstatic char rcsid[] = "$Header: /sprite/src/lib/tcl/compat/RCS/strstr.c,v 1.1 91/09/19 16:22:12 ouster Exp $ SPRITE (Berkeley)";
- X#endif /* not lint */
- X
- X/*
- X *----------------------------------------------------------------------
- X *
- X * strstr --
- X *
- X * Locate the first instance of a substring in a string.
- X *
- X * Results:
- X * If string contains substring, the return value is the
- X * location of the first matching instance of substring
- X * in string. If string doesn't contain substring, the
- X * return value is 0. Matching is done on an exact
- X * character-for-character basis with no wildcards or special
- X * characters.
- X *
- X * Side effects:
- X * None.
- X *
- X *----------------------------------------------------------------------
- X */
- X
- Xchar *
- Xstrstr(string, substring)
- X register char *string; /* String to search. */
- X char *substring; /* Substring to try to find in string. */
- X{
- X register char *a, *b;
- X
- X /* First scan quickly through the two strings looking for a
- X * single-character match. When it's found, then compare the
- X * rest of the substring.
- X */
- X
- X b = substring;
- X if (*b == 0) {
- X return string;
- X }
- X for ( ; *string != 0; string += 1) {
- X if (*string != *b) {
- X continue;
- X }
- X a = string;
- X while (1) {
- X if (*b == 0) {
- X return string;
- X }
- X if (*a++ != *b++) {
- X break;
- X }
- X }
- X b = substring;
- X }
- X return (char *) 0;
- X}
- END_OF_FILE
- if test 1922 -ne `wc -c <'tcl6.1/compat/strstr.c'`; then
- echo shar: \"'tcl6.1/compat/strstr.c'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/compat/strstr.c'
- fi
- if test -f 'tcl6.1/compat/testpid.c' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/compat/testpid.c'\"
- else
- echo shar: Extracting \"'tcl6.1/compat/testpid.c'\" \(931 characters\)
- sed "s/^X//" >'tcl6.1/compat/testpid.c' <<'END_OF_FILE'
- X/*
- X * testpid.c --
- X *
- X * This file contains a simple program that will compile
- X * correctly if and only if <sys/types.h> defines the
- X * type pid_t and uid_t. It is used to determine whether
- X * these types are defined on a given system.
- X *
- X * Copyright 1991 Regents of the University of California
- X * Permission to use, copy, modify, and distribute this
- X * software and its documentation for any purpose and without
- X * fee is hereby granted, provided that this copyright
- X * notice appears in all copies. The University of California
- X * makes no representations about the suitability of this
- X * software for any purpose. It is provided "as is" without
- X * express or implied warranty.
- X */
- X
- X#ifndef lint
- Xstatic char rcsid[] = "$Header: /user6/ouster/tcl/compat/RCS/testpid.c,v 1.1 91/11/07 10:26:53 ouster Exp $ SPRITE (Berkeley)";
- X#endif /* not lint */
- X
- X#include <sys/types.h>
- X
- Xpid_t pid;
- Xuid_t uid;
- X
- Xint main()
- X{
- X return 0;
- X}
- END_OF_FILE
- if test 931 -ne `wc -c <'tcl6.1/compat/testpid.c'`; then
- echo shar: \"'tcl6.1/compat/testpid.c'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/compat/testpid.c'
- fi
- if test -f 'tcl6.1/compat/testwait.c' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/compat/testwait.c'\"
- else
- echo shar: Extracting \"'tcl6.1/compat/testwait.c'\" \(946 characters\)
- sed "s/^X//" >'tcl6.1/compat/testwait.c' <<'END_OF_FILE'
- X/*
- X * testwait.c --
- X *
- X * This file contains a simple program that will compile
- X * correctly if and only if <sys/wait.h> defines the
- X * type "union wait". It is used during configuration
- X * to determine whether or not to use this type.
- X *
- X * Copyright 1991 Regents of the University of California
- X * Permission to use, copy, modify, and distribute this
- X * software and its documentation for any purpose and without
- X * fee is hereby granted, provided that this copyright
- X * notice appears in all copies. The University of California
- X * makes no representations about the suitability of this
- X * software for any purpose. It is provided "as is" without
- X * express or implied warranty.
- X */
- X
- X#ifndef lint
- Xstatic char rcsid[] = "$Header: /user6/ouster/tcl/compat/RCS/testwait.c,v 1.1 91/11/07 10:26:56 ouster Exp $ SPRITE (Berkeley)";
- X#endif /* not lint */
- X
- X#include <sys/types.h>
- X#include <sys/wait.h>
- X
- Xunion wait x;
- X
- Xint main()
- X{
- X return 0;
- X}
- END_OF_FILE
- if test 946 -ne `wc -c <'tcl6.1/compat/testwait.c'`; then
- echo shar: \"'tcl6.1/compat/testwait.c'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/compat/testwait.c'
- fi
- if test ! -d 'tcl6.1/doc' ; then
- echo shar: Creating directory \"'tcl6.1/doc'\"
- mkdir 'tcl6.1/doc'
- fi
- if test ! -d 'tcl6.1/library' ; then
- echo shar: Creating directory \"'tcl6.1/library'\"
- mkdir 'tcl6.1/library'
- fi
- if test -f 'tcl6.1/library/mkindex.tcl' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/library/mkindex.tcl'\"
- else
- echo shar: Extracting \"'tcl6.1/library/mkindex.tcl'\" \(1662 characters\)
- sed "s/^X//" >'tcl6.1/library/mkindex.tcl' <<'END_OF_FILE'
- X# auto_mkindex:
- X# Given a directory and a glob-style specification for files in that
- X# directory, generate a "tclIndex" file in the directory that is suitable
- X# for use in auto-loading. Returns a null string.
- X#
- X# $Header: /sprite/src/lib/tcl/scripts/RCS/mkindex.tcl,v 1.1 91/09/26 09:55:03 ouster Exp $ SPRITE (Berkeley)
- X#
- X# Copyright 1991 Regents of the University of California
- X# Permission to use, copy, modify, and distribute this
- X# software and its documentation for any purpose and without
- X# fee is hereby granted, provided that this copyright
- X# notice appears in all copies. The University of California
- X# makes no representations about the suitability of this
- X# software for any purpose. It is provided "as is" without
- X# express or implied warranty.
- X#
- X
- Xproc auto_mkindex {dir files} {
- X set oldDir [pwd]
- X cd $dir
- X set dir [pwd]
- X append index "# Tcl autoload index file: each line identifies a Tcl\n"
- X append index "# procedure and the file where that procedure is\n"
- X append index "# defined. Generated by the \"auto_mkindex\" command.\n"
- X append index "\n"
- X foreach file [glob $files] {
- X set f ""
- X set error [catch {
- X set f [open $file]
- X while {[gets $f line] >= 0} {
- X if [regexp {^proc[ ]+([^ ]*)} $line match indices] {
- X set procName [string range $line [lindex $indices 0] \
- X [lindex $indices 1]]
- X append index "[list $procName $file]\n"
- X }
- X }
- X close $f
- X } msg]
- X if $error {
- X set code $errorCode
- X set info $errorInfo
- X catch [close $f]
- X cd $oldDir
- X error $msg $info $code
- X }
- X }
- X set f [open tclIndex w]
- X puts $f $index nonewline
- X close $f
- X cd $oldDir
- X}
- END_OF_FILE
- if test 1662 -ne `wc -c <'tcl6.1/library/mkindex.tcl'`; then
- echo shar: \"'tcl6.1/library/mkindex.tcl'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/library/mkindex.tcl'
- fi
- if test -f 'tcl6.1/library/parray.tcl' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/library/parray.tcl'\"
- else
- echo shar: Extracting \"'tcl6.1/library/parray.tcl'\" \(1001 characters\)
- sed "s/^X//" >'tcl6.1/library/parray.tcl' <<'END_OF_FILE'
- X# parray:
- X# Print the contents of a global array on stdout.
- X#
- X# $Header: /sprite/src/lib/tcl/scripts/RCS/parray.tcl,v 1.1 91/09/26 09:55:03 ouster Exp $ SPRITE (Berkeley)
- X#
- X# Copyright 1991 Regents of the University of California
- X# Permission to use, copy, modify, and distribute this
- X# software and its documentation for any purpose and without
- X# fee is hereby granted, provided that this copyright
- X# notice appears in all copies. The University of California
- X# makes no representations about the suitability of this
- X# software for any purpose. It is provided "as is" without
- X# express or implied warranty.
- X#
- X
- Xproc parray a {
- X global $a
- X set maxl 0
- X foreach name [lsort [array names $a]] {
- X if {[string length $name] > $maxl} {
- X set maxl [string length $name]
- X }
- X }
- X set maxl [expr {$maxl + [string length $a] + 2}]
- X foreach name [lsort [array names $a]] {
- X set nameString [format %s(%s) $a $name]
- X puts stdout [format "%-*s = %s" $maxl $nameString [set ${a}($name)]]
- X }
- X}
- END_OF_FILE
- if test 1001 -ne `wc -c <'tcl6.1/library/parray.tcl'`; then
- echo shar: \"'tcl6.1/library/parray.tcl'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/library/parray.tcl'
- fi
- if test -f 'tcl6.1/library/tclIndex' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/library/tclIndex'\"
- else
- echo shar: Extracting \"'tcl6.1/library/tclIndex'\" \(277 characters\)
- sed "s/^X//" >'tcl6.1/library/tclIndex' <<'END_OF_FILE'
- X# Tcl autoload index file: each line identifies a Tcl
- X# procedure and the file where that procedure is
- X# defined. Generated by the "auto_mkindex" command.
- X
- Xunknown init.tcl
- Xauto_load init.tcl
- Xauto_execok init.tcl
- Xauto_reset init.tcl
- Xauto_mkindex mkindex.tcl
- Xparray parray.tcl
- END_OF_FILE
- if test 277 -ne `wc -c <'tcl6.1/library/tclIndex'`; then
- echo shar: \"'tcl6.1/library/tclIndex'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/library/tclIndex'
- fi
- if test -f 'tcl6.1/panic.c' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/panic.c'\"
- else
- echo shar: Extracting \"'tcl6.1/panic.c'\" \(1603 characters\)
- sed "s/^X//" >'tcl6.1/panic.c' <<'END_OF_FILE'
- X/*
- X * panic.c --
- X *
- X * Source code for the "panic" library procedure for Tcl;
- X * individual applications will probably override this with
- X * an application-specific panic procedure.
- X *
- X * Copyright 1988-1991 Regents of the University of California
- X * Permission to use, copy, modify, and distribute this
- X * software and its documentation for any purpose and without
- X * fee is hereby granted, provided that the above copyright
- X * notice appears in all copies. The University of California
- X * makes no representations about the suitability of this
- X * software for any purpose. It is provided "as is" without
- X * express or implied warranty.
- X */
- X
- X#ifndef lint
- Xstatic char rcsid[] = "$Header: /user6/ouster/tcl/RCS/panic.c,v 1.3 91/10/10 11:25:51 ouster Exp $ SPRITE (Berkeley)";
- X#endif
- X
- X#include <stdio.h>
- X#include <stdlib.h>
- X
- X/*
- X *----------------------------------------------------------------------
- X *
- X * panic --
- X *
- X * Print an error message and kill the process.
- X *
- X * Results:
- X * None.
- X *
- X * Side effects:
- X * The process dies, entering the debugger if possible.
- X *
- X *----------------------------------------------------------------------
- X */
- X
- X /* VARARGS ARGSUSED */
- Xvoid
- Xpanic(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8)
- X char *format; /* Format string, suitable for passing to
- X * fprintf. */
- X char *arg1, *arg2, *arg3; /* Additional arguments (variable in number)
- X * to pass to fprintf. */
- X char *arg4, *arg5, *arg6, *arg7, *arg8;
- X{
- X (void) fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6,
- X arg7, arg8);
- X (void) fflush(stderr);
- X abort();
- X}
- END_OF_FILE
- if test 1603 -ne `wc -c <'tcl6.1/panic.c'`; then
- echo shar: \"'tcl6.1/panic.c'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/panic.c'
- fi
- if test -f 'tcl6.1/regexp.h' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/regexp.h'\"
- else
- echo shar: Extracting \"'tcl6.1/regexp.h'\" \(806 characters\)
- sed "s/^X//" >'tcl6.1/regexp.h' <<'END_OF_FILE'
- X/*
- X * Definitions etc. for regexp(3) routines.
- X *
- X * Caveat: this is V8 regexp(3) [actually, a reimplementation thereof],
- X * not the System V one.
- X */
- X
- X#ifndef _TCL
- X#include "tcl.h"
- X#endif
- X#ifndef _REGEXP
- X#define _REGEXP 1
- X
- X#define NSUBEXP 10
- Xtypedef struct regexp {
- X char *startp[NSUBEXP];
- X char *endp[NSUBEXP];
- X char regstart; /* Internal use only. */
- X char reganch; /* Internal use only. */
- X char *regmust; /* Internal use only. */
- X int regmlen; /* Internal use only. */
- X char program[1]; /* Unwarranted chumminess with compiler. */
- X} regexp;
- X
- Xextern regexp *regcomp _ANSI_ARGS_((char *exp));
- Xextern int regexec _ANSI_ARGS_((regexp *prog, char *string));
- Xextern void regsub _ANSI_ARGS_((regexp *prog, char *source, char *dest));
- Xextern void regerror _ANSI_ARGS_((char *msg));
- X
- X#endif /* REGEXP */
- END_OF_FILE
- if test 806 -ne `wc -c <'tcl6.1/regexp.h'`; then
- echo shar: \"'tcl6.1/regexp.h'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/regexp.h'
- fi
- if test ! -d 'tcl6.1/tests' ; then
- echo shar: Creating directory \"'tcl6.1/tests'\"
- mkdir 'tcl6.1/tests'
- fi
- if test -f 'tcl6.1/tests/all' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/tests/all'\"
- else
- echo shar: Extracting \"'tcl6.1/tests/all'\" \(315 characters\)
- sed "s/^X//" >'tcl6.1/tests/all' <<'END_OF_FILE'
- X# This file contains a top-level script to run all of the Tcl
- X# tests. Execute it by invoking "source all" when running tclTest
- X# in this directory.
- X#
- X# $Header: /sprite/src/lib/tcl/tests/RCS/all,v 1.4 91/09/08 13:43:07 ouster Exp $ (Berkeley)
- X
- Xforeach i [lsort [glob *.test]] {
- X puts stdout $i
- X source $i
- X}
- END_OF_FILE
- if test 315 -ne `wc -c <'tcl6.1/tests/all'`; then
- echo shar: \"'tcl6.1/tests/all'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/tests/all'
- fi
- if test -f 'tcl6.1/tests/concat.test' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/tests/concat.test'\"
- else
- echo shar: Extracting \"'tcl6.1/tests/concat.test'\" \(1604 characters\)
- sed "s/^X//" >'tcl6.1/tests/concat.test' <<'END_OF_FILE'
- X# Commands covered: concat
- X#
- X# This file contains a collection of tests for one or more of the Tcl
- X# built-in commands. Sourcing this file into Tcl runs the tests and
- X# generates output for errors. No output means no errors were found.
- X#
- X# Copyright 1991 Regents of the University of California
- X# Permission to use, copy, modify, and distribute this
- X# software and its documentation for any purpose and without
- X# fee is hereby granted, provided that this copyright notice
- X# appears in all copies. The University of California makes no
- X# representations about the suitability of this software for any
- X# purpose. It is provided "as is" without express or implied
- X# warranty.
- X#
- X# $Header: /sprite/src/lib/tcl/tests/RCS/concat.test,v 1.4 91/07/23 21:00:59 ouster Exp $ (Berkeley)
- X
- Xif {[string compare test [info procs test]] == 1} then {source defs}
- X
- Xtest concat-1.1 {simple concatenation} {
- X concat a b c d e f g
- X} {a b c d e f g}
- Xtest concat-1.2 {merging lists together} {
- X concat a {b c d} {e f g h}
- X} {a b c d e f g h}
- Xtest concat-1.3 {merge lists, retain sub-lists} {
- X concat a {b {c d}} {{e f}} g h
- X} {a b {c d} {e f} g h}
- Xtest concat-1.4 {special characters} {
- X concat a\{ {b \{c d} \{d
- X} "a{ b \\{c d {d"
- X
- Xtest concat-2.1 {error: no arguments} {catch concat} 1
- Xtest concat-2.2 {error: no arguments} {
- X catch concat msg
- X set msg
- X} {wrong # args: should be "concat arg ?arg ...?"}
- X
- Xtest concat-3.1 {pruning off extra white space} {
- X concat {} {a b c}
- X} {a b c}
- Xtest concat-3.2 {pruning off extra white space} {
- X concat x y " a b c \n\t " " " " def "
- X} {x y a b c def}
- END_OF_FILE
- if test 1604 -ne `wc -c <'tcl6.1/tests/concat.test'`; then
- echo shar: \"'tcl6.1/tests/concat.test'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/tests/concat.test'
- fi
- if test -f 'tcl6.1/tests/defs' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/tests/defs'\"
- else
- echo shar: Extracting \"'tcl6.1/tests/defs'\" \(1884 characters\)
- sed "s/^X//" >'tcl6.1/tests/defs' <<'END_OF_FILE'
- X# This file contains support code for the Tcl test suite. It is
- X# normally sourced by the individual files in the test suite before
- X# they run their tests. This improved approach to testing was designed
- X# and initially implemented by Mary Ann May-Pumphrey of Sun Microsystems.
- X
- Xset VERBOSE 0
- Xset TESTS {}
- Xset auto_noexec 1
- Xset auto_noload 1
- Xcatch {rename unknown ""}
- X
- X# If tests are being run as root, issue a warning message and set a
- X# variable to prevent some tests from running at all.
- X
- Xset user {}
- Xcatch {set user [exec whoami]}
- Xif {$user == "root"} {
- X puts stdout "Warning: you're executing as root. I'll have to"
- X puts stdout "skip some of the tests, since they'll fail as root."
- X}
- X
- Xproc print_verbose {test_name test_description contents_of_test answer} {
- X puts stdout "\n"
- X puts stdout "==== $test_name $test_description"
- X puts stdout "==== Contents of test case:"
- X puts stdout "$contents_of_test"
- X puts stdout "==== Result was:"
- X puts stdout "$answer"
- X}
- X
- Xproc test {test_name test_description contents_of_test passing_results} {
- X global VERBOSE
- X global TESTS
- X if {[string compare $TESTS ""] != 0} then {
- X set ok 0
- X foreach test $TESTS {
- X if [string match $test $test_name] then {
- X set ok 1
- X break
- X }
- X }
- X if !$ok then return
- X }
- X set answer [uplevel $contents_of_test]
- X if {[string compare $answer $passing_results] == 0} then {
- X if $VERBOSE then {
- X print_verbose $test_name $test_description $contents_of_test $answer
- X puts stdout "++++ $test_name PASSED"
- X }
- X } else {
- X print_verbose $test_name $test_description $contents_of_test $answer
- X puts stdout "---- Result should have been:"
- X puts stdout "$passing_results"
- X puts stdout "---- $test_name FAILED"
- X }
- X}
- X
- Xproc dotests {file args} {
- X global TESTS
- X set savedTests $TESTS
- X set TESTS $args
- X source $file
- X set TESTS $savedTests
- X}
- END_OF_FILE
- if test 1884 -ne `wc -c <'tcl6.1/tests/defs'`; then
- echo shar: \"'tcl6.1/tests/defs'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/tests/defs'
- fi
- if test -f 'tcl6.1/tests/eval.test' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/tests/eval.test'\"
- else
- echo shar: Extracting \"'tcl6.1/tests/eval.test'\" \(1765 characters\)
- sed "s/^X//" >'tcl6.1/tests/eval.test' <<'END_OF_FILE'
- X# Commands covered: eval
- X#
- X# This file contains a collection of tests for one or more of the Tcl
- X# built-in commands. Sourcing this file into Tcl runs the tests and
- X# generates output for errors. No output means no errors were found.
- X#
- X# Copyright 1991 Regents of the University of California
- X# Permission to use, copy, modify, and distribute this
- X# software and its documentation for any purpose and without
- X# fee is hereby granted, provided that this copyright notice
- X# appears in all copies. The University of California makes no
- X# representations about the suitability of this software for any
- X# purpose. It is provided "as is" without express or implied
- X# warranty.
- X#
- X# $Header: /sprite/src/lib/tcl/tests/RCS/eval.test,v 1.4 91/08/20 14:19:02 ouster Exp $ (Berkeley)
- X
- Xif {[string compare test [info procs test]] == 1} then {source defs}
- X
- Xtest eval-1.1 {single argument} {
- X eval {format 22}
- X} 22
- Xtest eval-1.2 {multiple arguments} {
- X set a {$b}
- X set b xyzzy
- X eval format $a
- X} xyzzy
- Xtest eval-1.3 {single argument} {
- X eval concat a b c d e f g
- X} {a b c d e f g}
- X
- Xtest eval-2.1 {error: not enough arguments} {catch eval} 1
- Xtest eval-2.2 {error: not enough arguments} {
- X catch eval msg
- X set msg
- X} {wrong # args: should be "eval arg ?arg ...?"}
- Xtest eval-2.3 {error in eval'ed command} {
- X catch {eval {error "test error"}}
- X} 1
- Xtest eval-2.4 {error in eval'ed command} {
- X catch {eval {error "test error"}} msg
- X set msg
- X} {test error}
- Xtest eval-2.5 {error in eval'ed command: setting errorInfo} {
- X catch {eval {
- X set a 1
- X error "test error"
- X }} msg
- X set errorInfo
- X} "test error
- X while executing
- X\"error \"test error\"\"
- X (\"eval\" body line 3)
- X invoked from within
- X\"eval {
- X set a 1
- X error \"test error\"
- X }\""
- END_OF_FILE
- if test 1765 -ne `wc -c <'tcl6.1/tests/eval.test'`; then
- echo shar: \"'tcl6.1/tests/eval.test'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/tests/eval.test'
- fi
- if test -f 'tcl6.1/tests/join.test' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/tests/join.test'\"
- else
- echo shar: Extracting \"'tcl6.1/tests/join.test'\" \(1519 characters\)
- sed "s/^X//" >'tcl6.1/tests/join.test' <<'END_OF_FILE'
- X# Commands covered: join
- X#
- X# This file contains a collection of tests for one or more of the Tcl
- X# built-in commands. Sourcing this file into Tcl runs the tests and
- X# generates output for errors. No output means no errors were found.
- X#
- X# Copyright 1991 Regents of the University of California
- X# Permission to use, copy, modify, and distribute this
- X# software and its documentation for any purpose and without
- X# fee is hereby granted, provided that this copyright notice
- X# appears in all copies. The University of California makes no
- X# representations about the suitability of this software for any
- X# purpose. It is provided "as is" without express or implied
- X# warranty.
- X#
- X# $Header: /sprite/src/lib/tcl/tests/RCS/join.test,v 1.3 91/08/01 17:19:57 ouster Exp $ (Berkeley)
- X
- Xif {[string compare test [info procs test]] == 1} then {source defs}
- X
- Xtest join-1.1 {basic join commands} {
- X join {a b c} xyz
- X} axyzbxyzc
- Xtest join-1.2 {basic join commands} {
- X join {a b c} {}
- X} abc
- Xtest join-1.3 {basic join commands} {
- X join {} xyz
- X} {}
- Xtest join-1.4 {basic join commands} {
- X join {12 34 56}
- X} {12 34 56}
- X
- Xtest join-2.1 {join errors} {
- X list [catch join msg] $msg $errorCode
- X} {1 {wrong # args: should be "join list ?joinString?"} NONE}
- Xtest join-2.2 {join errors} {
- X list [catch {join a b c} msg] $msg $errorCode
- X} {1 {wrong # args: should be "join list ?joinString?"} NONE}
- Xtest join-2.3 {join errors} {
- X list [catch {join "a \{ c" 111} msg] $msg $errorCode
- X} {1 {unmatched open brace in list} NONE}
- END_OF_FILE
- if test 1519 -ne `wc -c <'tcl6.1/tests/join.test'`; then
- echo shar: \"'tcl6.1/tests/join.test'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/tests/join.test'
- fi
- if test -f 'tcl6.1/tests/llength.test' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/tests/llength.test'\"
- else
- echo shar: Extracting \"'tcl6.1/tests/llength.test'\" \(1416 characters\)
- sed "s/^X//" >'tcl6.1/tests/llength.test' <<'END_OF_FILE'
- X# Commands covered: llength
- X#
- X# This file contains a collection of tests for one or more of the Tcl
- X# built-in commands. Sourcing this file into Tcl runs the tests and
- X# generates output for errors. No output means no errors were found.
- X#
- X# Copyright 1991 Regents of the University of California
- X# Permission to use, copy, modify, and distribute this
- X# software and its documentation for any purpose and without
- X# fee is hereby granted, provided that this copyright notice
- X# appears in all copies. The University of California makes no
- X# representations about the suitability of this software for any
- X# purpose. It is provided "as is" without express or implied
- X# warranty.
- X#
- X# $Header: /sprite/src/lib/tcl/tests/RCS/llength.test,v 1.1 91/09/06 14:48:03 ouster Exp $ (Berkeley)
- X
- Xif {[string compare test [info procs test]] == 1} then {source defs}
- X
- Xtest llength-1.1 {length of list} {
- X llength {a b c d}
- X} 4
- Xtest llength-1.2 {length of list} {
- X llength {a b c {a b {c d}} d}
- X} 5
- Xtest llength-1.3 {length of list} {
- X llength {}
- X} 0
- X
- Xtest llength-2.1 {error conditions} {
- X list [catch {llength} msg] $msg
- X} {1 {wrong # args: should be "llength list"}}
- Xtest llength-2.2 {error conditions} {
- X list [catch {llength 123 2} msg] $msg
- X} {1 {wrong # args: should be "llength list"}}
- Xtest llength-2.3 {error conditions} {
- X list [catch {llength "a b c \{"} msg] $msg
- X} {1 {unmatched open brace in list}}
- END_OF_FILE
- if test 1416 -ne `wc -c <'tcl6.1/tests/llength.test'`; then
- echo shar: \"'tcl6.1/tests/llength.test'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/tests/llength.test'
- fi
- if test -f 'tcl6.1/tests/lsearch.test' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/tests/lsearch.test'\"
- else
- echo shar: Extracting \"'tcl6.1/tests/lsearch.test'\" \(1630 characters\)
- sed "s/^X//" >'tcl6.1/tests/lsearch.test' <<'END_OF_FILE'
- X# Commands covered: lsearch
- X#
- X# This file contains a collection of tests for one or more of the Tcl
- X# built-in commands. Sourcing this file into Tcl runs the tests and
- X# generates output for errors. No output means no errors were found.
- X#
- X# Copyright 1991 Regents of the University of California
- X# Permission to use, copy, modify, and distribute this
- X# software and its documentation for any purpose and without
- X# fee is hereby granted, provided that this copyright notice
- X# appears in all copies. The University of California makes no
- X# representations about the suitability of this software for any
- X# purpose. It is provided "as is" without express or implied
- X# warranty.
- X#
- X# $Header: /sprite/src/lib/tcl/tests/RCS/lsearch.test,v 1.1 91/08/21 13:37:25 ouster Exp $ (Berkeley)
- X
- Xif {[string compare test [info procs test]] == 1} then {source defs}
- X
- Xset x {abcd bbcd 123 234 345}
- Xtest lsearch-1.1 {lsearch command} {
- X lsearch $x 123
- X} 2
- Xtest lsearch-1.2 {lsearch command} {
- X lsearch $x 3456
- X} -1
- Xtest lsearch-1.3 {lsearch command} {
- X lsearch $x *5
- X} 4
- Xtest lsearch-1.4 {lsearch command} {
- X lsearch $x *bc*
- X} 0
- X
- Xtest lsearch-2.1 {lsearch errors} {
- X list [catch lsearch msg] $msg
- X} {1 {wrong # args: should be "lsearch list pattern"}}
- Xtest lsearch-2.2 {lsearch errors} {
- X list [catch {lsearch a} msg] $msg
- X} {1 {wrong # args: should be "lsearch list pattern"}}
- Xtest lsearch-2.3 {lsearch errors} {
- X list [catch {lsearch a b c} msg] $msg
- X} {1 {wrong # args: should be "lsearch list pattern"}}
- Xtest lsearch-2.4 {lsearch errors} {
- X list [catch {lsearch "\{" b} msg] $msg
- X} {1 {unmatched open brace in list}}
- END_OF_FILE
- if test 1630 -ne `wc -c <'tcl6.1/tests/lsearch.test'`; then
- echo shar: \"'tcl6.1/tests/lsearch.test'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/tests/lsearch.test'
- fi
- if test -f 'tcl6.1/tests/lsort.test' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/tests/lsort.test'\"
- else
- echo shar: Extracting \"'tcl6.1/tests/lsort.test'\" \(1505 characters\)
- sed "s/^X//" >'tcl6.1/tests/lsort.test' <<'END_OF_FILE'
- X# Commands covered: lsort
- X#
- X# This file contains a collection of tests for one or more of the Tcl
- X# built-in commands. Sourcing this file into Tcl runs the tests and
- X# generates output for errors. No output means no errors were found.
- X#
- X# Copyright 1991 Regents of the University of California
- X# Permission to use, copy, modify, and distribute this
- X# software and its documentation for any purpose and without
- X# fee is hereby granted, provided that this copyright notice
- X# appears in all copies. The University of California makes no
- X# representations about the suitability of this software for any
- X# purpose. It is provided "as is" without express or implied
- X# warranty.
- X#
- X# $Header: /sprite/src/lib/tcl/tests/RCS/lsort.test,v 1.1 91/08/21 13:37:25 ouster Exp $ (Berkeley)
- X
- Xif {[string compare test [info procs test]] == 1} then {source defs}
- X
- Xtest lsort-1.1 {lsort command} {
- X lsort {abdeq ab 1 ac a}
- X} {1 a ab abdeq ac}
- Xtest lsort-1.2 {lsort command} {
- X lsort {{one long element}}
- X} {{one long element}}
- Xtest lsort-1.3 {lsort command} {
- X lsort {}
- X} {}
- Xtest lsort-1.4 {lsort with characters needing backslashes} {
- X lsort {$ \\ [] \{}
- X} {{$} {[]} \\ \{}
- X
- Xtest lsort-2.1 {lsort errors} {
- X list [catch lsort msg] $msg
- X} {1 {wrong # args: should be "lsort list"}}
- Xtest lsort-2.2 {lsort errors} {
- X list [catch {lsort a b} msg] $msg
- X} {1 {wrong # args: should be "lsort list"}}
- Xtest lsort-2.3 {lsort errors} {
- X list [catch {lsort "\{"} msg] $msg
- X} {1 {unmatched open brace in list}}
- END_OF_FILE
- if test 1505 -ne `wc -c <'tcl6.1/tests/lsort.test'`; then
- echo shar: \"'tcl6.1/tests/lsort.test'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/tests/lsort.test'
- fi
- if test -f 'tcl6.1/tests/split.test' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/tests/split.test'\"
- else
- echo shar: Extracting \"'tcl6.1/tests/split.test'\" \(1701 characters\)
- sed "s/^X//" >'tcl6.1/tests/split.test' <<'END_OF_FILE'
- X# Commands covered: split
- X#
- X# This file contains a collection of tests for one or more of the Tcl
- X# built-in commands. Sourcing this file into Tcl runs the tests and
- X# generates output for errors. No output means no errors were found.
- X#
- X# Copyright 1991 Regents of the University of California
- X# Permission to use, copy, modify, and distribute this
- X# software and its documentation for any purpose and without
- X# fee is hereby granted, provided that this copyright notice
- X# appears in all copies. The University of California makes no
- X# representations about the suitability of this software for any
- X# purpose. It is provided "as is" without express or implied
- X# warranty.
- X#
- X# $Header: /sprite/src/lib/tcl/tests/RCS/split.test,v 1.2 91/08/11 17:08:26 ouster Exp $ (Berkeley)
- X
- Xif {[string compare test [info procs test]] == 1} then {source defs}
- X
- Xtest split-1.1 {basic split commands} {
- X split "a\n b\t\r c\n "
- X} {a {} b {} {} c {} {}}
- Xtest split-1.2 {basic split commands} {
- X split "word 1xyzword 2zword 3" xyz
- X} {{word 1} {} {} {word 2} {word 3}}
- Xtest split-1.3 {basic split commands} {
- X split "12345" {}
- X} {1 2 3 4 5}
- Xtest split-1.4 {basic split commands} {
- X split "a\}b\[c\{\]\$"
- X} "a}b\\\[c{\\\]\\\$"
- Xtest split-1.5 {basic split commands} {
- X split {} {}
- X} {}
- Xtest split-1.6 {basic split commands} {
- X split {}
- X} {}
- Xtest split-1.7 {basic split commands} {
- X split { }
- X} {{} {} {} {}}
- X
- Xtest split-2.1 {split errors} {
- X list [catch split msg] $msg $errorCode
- X} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
- Xtest split-2.2 {split errors} {
- X list [catch {split a b c} msg] $msg $errorCode
- X} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
- END_OF_FILE
- if test 1701 -ne `wc -c <'tcl6.1/tests/split.test'`; then
- echo shar: \"'tcl6.1/tests/split.test'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/tests/split.test'
- fi
- if test -f 'tcl6.1/tests/unknown.test' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'tcl6.1/tests/unknown.test'\"
- else
- echo shar: Extracting \"'tcl6.1/tests/unknown.test'\" \(1948 characters\)
- sed "s/^X//" >'tcl6.1/tests/unknown.test' <<'END_OF_FILE'
- X# Commands covered: unknown
- X#
- X# This file contains a collection of tests for one or more of the Tcl
- X# built-in commands. Sourcing this file into Tcl runs the tests and
- X# generates output for errors. No output means no errors were found.
- X#
- X# Copyright 1991 Regents of the University of California
- X# Permission to use, copy, modify, and distribute this
- X# software and its documentation for any purpose and without
- X# fee is hereby granted, provided that this copyright notice
- X# appears in all copies. The University of California makes no
- X# representations about the suitability of this software for any
- X# purpose. It is provided "as is" without express or implied
- X# warranty.
- X#
- X# $Header: /sprite/src/lib/tcl/tests/RCS/unknown.test,v 1.3 91/08/21 13:53:23 ouster Exp $ (Berkeley)
- X
- Xif {[string compare test [info procs test]] == 1} then {source defs}
- X
- Xcatch {rename unknown {}}
- X
- Xtest unknown-1.1 {non-existent "unknown" command} {
- X list [catch {_non-existent_ foo bar} msg] $msg
- X} {1 {invalid command name: "_non-existent_"}}
- X
- Xproc unknown {args} {
- X global x
- X set x $args
- X}
- X
- Xtest unknown-2.1 {calling "unknown" command} {
- X foobar x y z
- X set x
- X} {foobar x y z}
- Xtest unknown-2.2 {calling "unknown" command with lots of args} {
- X foobar 1 2 3 4 5 6 7
- X set x
- X} {foobar 1 2 3 4 5 6 7}
- Xtest unknown-2.3 {calling "unknown" command with lots of args} {
- X foobar 1 2 3 4 5 6 7 8
- X set x
- X} {foobar 1 2 3 4 5 6 7 8}
- Xtest unknown-2.4 {calling "unknown" command with lots of args} {
- X foobar 1 2 3 4 5 6 7 8 9
- X set x
- X} {foobar 1 2 3 4 5 6 7 8 9}
- X
- Xtest unknown-3.1 {argument quoting in calls to "unkown"} {
- X foobar \{ \} a\{b \; "\\" \$a a\[b \]
- X set x
- X} "foobar \\{ \} a\{b {;} \\\\ {\$a} {a\[b} \\]"
- X
- Xproc unknown args {
- X error "unknown failed"
- X}
- X
- Xtest unknown-4.1 {errors in "unknown" procedure} {
- X list [catch {non-existent a b} msg] $msg $errorCode
- X} {1 {unknown failed} NONE}
- X
- Xcatch {rename unknown {}}
- Xreturn {}
- END_OF_FILE
- if test 1948 -ne `wc -c <'tcl6.1/tests/unknown.test'`; then
- echo shar: \"'tcl6.1/tests/unknown.test'\" unpacked with wrong size!
- fi
- # end of 'tcl6.1/tests/unknown.test'
- fi
- echo shar: End of archive 1 \(of 33\).
- cp /dev/null ark1isdone
- MISSING=""
- for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 ; do
- if test ! -f ark${I}isdone ; then
- MISSING="${MISSING} ${I}"
- fi
- done
- if test "${MISSING}" = "" ; then
- echo You have unpacked all 33 archives.
- rm -f ark[1-9]isdone ark[1-9][0-9]isdone
- else
- echo You still need to unpack the following archives:
- echo " " ${MISSING}
- fi
- ## End of shell archive.
- exit 0
-
- exit 0 # Just in case...
- --
- Kent Landfield INTERNET: kent@sparky.IMD.Sterling.COM
- Sterling Software, IMD UUCP: uunet!sparky!kent
- Phone: (402) 291-8300 FAX: (402) 291-4362
- Please send comp.sources.misc-related mail to kent@uunet.uu.net.
-